*  FILE NAME: PURC_CR.PRG
*  BY: NURJADI PURNAMA
*  DATE: May 31, 1996
*  DESC:
*  CALLED BY:
*  DATA FILES:
CLEA
DR='N:'
F1='PUR_DRUG'
F2='PUR_DISP'
SET EXCLU OFF
USE &DR&F1
INDEX ON ORDER_NBER TO &DR&F1
SET EXCLU OFF
USE &DR&F2
INDEX ON ORDER_NBER TO &DR&F2
GO BOTT
SET EXCLU OFF
CLOS DATA
CLOSE INDEX
F1='SUPPLIER'
F2='PUR_DRUG'
F3='PUR_DISP'
F4='DRUGS'
F5='DISPOS'
DO ADDRESSC
SUPPCOD=SPACE(4)
ORDNBER=SPACE(4)
SELE 1
SET EXCLU OFF
USE &DR&F1
SELE 2
SET EXCLU OFF
USE &DR&F2
SELE 3
SET EXCLU OFF
USE &DR&F3
SELE 4
SET EXCLU OFF
USE &DR&F4 INDE &DR&F4
SELE 5
SET EXCLU OFF
USE &DR&F5 INDE &DR&F5
PR=0
SELE 1
WFLAG=0
WFLAG=1
PR=PR+1
IF PR=1
   @  5,  3  TO  7, 33    DOUBLE
   @  6,  5  SAY "REPRINT PURCHASE ORDER FORM"
   PRNUM=0
   @  10,26 SAY 'PURCHASE ORDER #. : 'GET PRNUM PICT '99999'
   READ
   IF PRNUM=0 .OR. LASTKEY()=27
      CLOSE ALL
      RETURN
   ENDIF
   KLR='N'
   DO SET_DEV
   IF KLR='Y'
      CLOSE ALL
      RETURN
   ENDIF
ENDIF
SELE 2
LOCA FOR ORDER_NBER=PRNUM .AND. .NOT. EOF()
IF .NOT. FOUND()
   SELE 3
   LOCA FOR ORDER_NBER=PRNUM .AND. .NOT. EOF()
   IF .NOT. FOUND()
      RETURN
   ENDIF
ENDIF
SUPPCOD=SUPP_CODE
SELE 1
LOCA FOR SUPP_CODE=SUPPCOD .AND. .NOT. EOF()
SUPPCUR=SUPP_CURR
DO CASE
CASE SUPPCUR='IDR'
   WCUR='RUPIAH'
CASE SUPPCUR='USD' .OR. SUPPCUR='SGD' .OR. SUPPCUR='AUD'
   WCUR='DOLLAR'
CASE SUPPCUR='JPY'
   WCUR='YEN'
CASE SUPPCUR='FFR'
   WCUR='FRANC'
CASE SUPPCUR='GBP'
   WCUR='POUNDSTERLING'
CASE SUPPCUR='RMB'
   WCUR='RMB'
OTHER
   WCUR=' '
ENDCASE
SUPPNAM=SUPP_NAME
SUPPADD1=SUPP_ADD1
SUPPADD2=SUPP_ADD2
SUPPCITY=SUPP_CITY
SUPPCOUNT=SUPP_COUNT
SUPPTEL=SUPP_TEL1
SUPPFAX=SUPP_FAX
SUPPTELEX=SUPP_TELEX
CONPER=CONTACT_P
MPPN=PPN
PAYTERM=TERM_PAYMT
store 0 to ttl1,ttl2,ttl3,ttl4,ttl5
set devi to print
*@ 0,0 say chr(18) pict 'x'
*@ 0,0 SAY CHR(27)+CHR(77)
ULANG='N'
CNT=0
TTL=0
BR=0
ITM=0
DO WHILE CNT<=1
   @ 0,0 say chr(18) pict 'x'
   @ 0,0 SAY CHR(27)+CHR(77)
   CNT=CNT+1
   @  1, 00 SAY AEANAME
   @  2, 00 SAY AEAADDR
   @  3, 00 SAY AEACITY
   @  5, 24 SAY CHR(14)+'P U R C H A S E  O R D E R'
   @  6, 24 SAY CHR(14)+'--------------------------'
   @  7, 28 SAY 'PURCHASE ORDER NO. : '+ALLTRIM(STR(PRNUM,5))
   @  7, 58 say 'DATE : '+DTOC(DATE())
   @  9,  0 SAY 'SUPPLIER : '+SUPPNAM
   @ 10,  0 SAY "ADDRESS  : "+SUPPADD1
   @ 11, 12 SAY SUPPADD2
   @ 11, 64 SAY "CITY  : "+SUPPCITY
   @ 12,  0 SAY "Telephone : "+SUPPTEL
   @ 12, 30 SAY "Fax  : "+SUPPFAX
   @ 12, 64 SAY "Telex : "+SUPPTELEX
*   @ 13,  0 say chr(15) pict 'x'
   @ 13,  0 say repl('=',102)
   @ 14,  0 SAY 'NO'
   @ 14,  6 say 'PRODUCT'
   @ 14, 28 SAY 'TYPE'
   @ 14, 41 say 'UNIT'
   @ 14, 51 SAY 'PACKAGING'
   @ 14, 62 SAY ' QTY.'
   @ 14, 68 SAY 'UNIT PRICE'
   @ 14, 81 SAY " DISC"
   @ 14, 90 SAY "TOTAL PRICE"
   @ 15,0 say repl('-',102)
   BR=15
   SELE 2
   GO TOP
   LOCATE FOR ORDER_NBER=PRNUM  .AND. .NOT. EOF()
   DO WHILE .T.
      IF FOUND()
         br=br+1
         ITM=ITM+1
         IF ITM>=31
            ULANG='Y'
            EXIT
         ENDIF
         DRCD=DRUG_CODE
         qty =qant_purch
         SELE 4
         SEEK DRCD
         BSEL=STR(BUY_SELL_R,4)
         SELE 2
         @ BR,  1 SAY STR(INT(ITM),2)
         @ BR,  6 SAY DRUG_NAME
         @ BR, 28 SAY DRUG_TYPE
         @ BR, 41 SAY DRUG_QANT+" "+DRUG_UNIT
         @ BR, 51 SAY ALLTRIM(SUBS(BUY_UNIT,1,9))+' '+ALLTRIM(BSEL)
         @ BR, 62 SAY QANT_PURCH PICT '9,999'
         
         IF AEADECI
            @ BR, 67 SAY U_PR_PURCH PICT '99,999,999.99'
         ELSE
            @ BR, 68 SAY U_PR_PURCH PICT '99,999,999'
         ENDIF
         
         *               @ BR, 77 SAY VALU_PURCH PICT '9,999,999'
         
         IF DISC_PURCH<>0
            @ BR, 81 SAY DISC_PURCH PICT "99.9"
            @ BR, 85 SAY "%"
         ENDIF
         
         IF AEADECI
            @ BR,89  SAY NET_PURCH PICT "99,999,999.99"
         ELSE
            @ BR,90  SAY NET_PURCH PICT "99,999,999"
         ENDIF
         
         TTL=TTL+NET_PURCH
         *              BR=BR+1
         CONTINUE
         LOOP
      ELSE
         EXIT
      ENDIF
   ENDDO
   SELE 3
   GO TOP
   LOCATE FOR ORDER_NBER=PRNUM  .AND. .NOT. EOF()
   DO WHILE .T.
      IF FOUND()
         br=br+1
         ITM=ITM+1
         IF ITM>=31
            ULANG='Y'
            EXIT
         ENDIF
         DSCD=DISP_CODE
         qty =qant_purch
         SELE 5
         SEEK DSCD
         BSEL=STR(BUY_SELL_R,4)
         SELE 3
         @ BR,  1 SAY STR(INT(ITM),2)
         @ BR,  6 SAY DISP_NAME
         @ BR, 28 SAY DISP_TYPE
         @ BR, 41 SAY DISP_QANT+" "+DISP_UNIT
         @ BR, 51 SAY ALLTRIM(SUBS(BUY_UNIT,1,9))+' '+ALLTRIM(BSEL)
         @ BR, 62 SAY QANT_PURCH PICT '9,999'
         IF AEADECI
            @ BR, 67 SAY U_PR_PURCH PICT '99,999,999.99'
         ELSE
            @ BR, 68 SAY U_PR_PURCH PICT '99,999,999'
         ENDIF
         IF DISC_PURCH<>0
            @ BR, 81 SAY DISC_PURCH PICT "99.9"
            @ BR, 85 SAY "%"
         ENDIF
         IF AEADECI
            @ BR,89  SAY NET_PURCH PICT "99,999,999.99"
         ELSE
            @ BR,90  SAY NET_PURCH PICT "99,999,999"
         ENDIF
         TTL=TTL+NET_PURCH
         CONTINUE
         LOOP
      ELSE
         EXIT
      ENDIF
   ENDDO
   IF TTL<>0
      @ 46, 00 SAY REPL('-',102)
      IF MPPN=.T.
         @ 47, 61 SAY "VALUE BEFORE TAX    : "+SUPPCUR
         IF AEADECI
            do secnil with 47,88,ttl
         ELSE
            do secnilRP with 47,89,ttl
         ENDIF
         @ 48, 61 SAY "P.P.N.  10 %        : "+SUPPCUR
         VALPPN=10/100*TTL
         GRNTTL=TTL+VALPPN
         IF AEADECI
            do secnil1 with 48,88,valppn
         ELSE
            do secnil1R with 48,89,valppn
         ENDIF
         I=0
         X=1
         SX=0
         BARI=48
         Declare ARRAY1[3]
         HARGA=NTOS2(GRNTTL,WCUR,'CENT')
         S_PARSE(HARGA,3,50,ARRAY1)
         DO WHILE X<=I
            @ BARI,1 SAY ARRAY1[X]
            IF BARI=49
               SX=1
               @ 49, 88 SAY '-------------'
            ENDIF
            X=X+1
            bari=bari+1
         ENDDO
         IF SX=0
            @ 49, 88 SAY '-------------'
         ENDIF
         @ 50, 61 say 'TOTAL VALUE OF P.O. : '+SUPPCUR
         IF AEADECI
            do secnil1 with 50,88,grnttl
         ELSE
            do secnil1R with 50,89,grnttl
         ENDIF
         
      ELSE
         @ 47, 61 say 'TOTAL VALUE OF P.O. : '+SUPPCUR
         IF AEADECI
            do secnil with 47,88,ttl
         ELSE
            do secnilRP with 47,89,ttl
         ENDIF
         I=0
         X=1
         BARI=48
         Declare ARRAY1[3]
         HARGA=NTOS2(TTL,WCUR,'CENT')
         S_PARSE(HARGA,3,50,ARRAY1)
         DO WHILE X<=I
            @ BARI,1 SAY ARRAY1[X]
            X=X+1
            bari=bari+1
         ENDDO
      ENDIF
      TTL=0
      @ 51,  0 SAY REPL('-',102)
      *            @ 53,  0 SAY "PAYMENT DUE "+LTRIM(STR(PAYTERM,3))+" DAYS AFTER COMPLETE DELIVERY AND SUBMISSION OF INVOICE"
      *            @ 53, 75 SAY "AUTHORIZED SIGNATURE :"
      *            IF MPPN=.T.
      *               @ 54, 0 SAY "NO PAYMENT WILL BE PROCESSED BEFORE SUBMISSION OF FAKTUR PAJAK"
      *           ENDIF
      *           @ 55,  0 SAY "COPY OF THIS PURCHASE ORDER SHOULD BE PRESENTED AT TIME OF DELIVERY"
      *           @ 59, 75 SAY "____________________ "
      @ 53,  0 SAY "COPY #1 FOR SUPPLIER ;  #2 FOR PURCHASING ;  #3 FOR ACCOUNTING"
      ITM=0
   ENDIF
   IF CNT=1
      EXIT
   ENDIF
   EJECT
ENDDO
CLOSE ALL
SET PRINT OFF
SET DEVI TO SCREE
RETURN


*Formatted by: Herman T Ver. 7.1  on May 31, 1996.
